home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / nrpas13.arc / ELMHES.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-01  |  1KB  |  46 lines
  1. PROCEDURE elmhes(VAR a: glnpnp; n: integer);
  2. (* Programs using routine ELMHES must define the type
  3. TYPE
  4.    glnpnp = ARRAY [1..np,1..np]
  5. where 'np by np' is the physical dimension of the matrix to be reduced. *)
  6. VAR
  7.    m,j,i: integer;
  8.    y,x: real;
  9. BEGIN
  10.    IF (n > 2) THEN BEGIN
  11.       FOR m := 2 TO n-1 DO BEGIN
  12.          x := 0.0;
  13.          i := m;
  14.          FOR j := m TO n DO BEGIN
  15.             IF (abs(a[j,m-1]) > abs(x)) THEN BEGIN
  16.                x := a[j,m-1];
  17.                i := j
  18.             END
  19.          END;
  20.          IF (i <> m) THEN BEGIN
  21.             FOR j := m-1 TO n DO BEGIN
  22.                y := a[i,j];
  23.                a[i,j] := a[m,j];
  24.                a[m,j] := y
  25.             END;
  26.             FOR j := 1 TO n DO BEGIN
  27.                y := a[j,i];
  28.                a[j,i] := a[j,m];
  29.                a[j,m] := y
  30.             END
  31.          END;
  32.          IF (x <> 0.0) THEN BEGIN
  33.             FOR i := m+1 TO n DO BEGIN
  34.                y := a[i,m-1];
  35.                IF (y <> 0.0) THEN BEGIN
  36.                   y := y/x;
  37.                   a[i,m-1] := y;
  38.                   FOR j := m TO n DO a[i,j] := a[i,j]-y*a[m,j];
  39.                   FOR j := 1 TO n DO a[j,m] := a[j,m]+y*a[j,i]
  40.                END
  41.             END
  42.          END
  43.       END
  44.    END
  45. END;
  46.